1. Introduction

1.1. Objectives

  • Demonstrate CMML activities
  • Define CMML critical needs and inform management
  • Overview of CMML raw material procurement
  • Understand customer request and organize media production as well as media delivery

–> Data of media production, distribution and raw materials were extracted from Central Media Making Laboratory System (CMMLMS) database in comma separated value and imported to R programming language for cleaning and analysis.

1.2. Background

The Diagnostic Microbiology Development Program (DMDP) has been working with the University of Health Sciences (UHS) in Phnom Penh, Cambodia since 2011 to provide a sustainable source of quality-controlled media such as blood culture broth bottles, agar plates, and media for identification of bacteriological agents. The media is produced and quality controlled by following guidelines for Assuring Quality of Medical Microbiology Culture Media; Clinical and Laboratory Standards Institute (CLSI M22) and Australian Society for Microbiology 2nd edition to guide development of CMML standard operating procedures (SOP) and processes. In 2017, DMDP supported the expansion and renovation of premises, purchase and installation of equipment and long-term on-site technical mentoring. Care and bleeding of sheep ensured access to a sustainable source of sheep blood. Since February 2019, CMML held ISO certification (ISO 9001:2015). The media products were included in the Ministry of Health Essential Medicines List (EML) and more than 20 customers purchased media for their routine clinical bacteriology laboratory set up.

2. Raw materials

Raw materials are grouped by item name regardless of different brands to discover the current stock. Rows highlight in pink indicate that the item’s quantity is lower than the threshold. The items with zero threshold were excluded from highlighting. Note: raw data might not up to date. It is depends on the day data extracted from CMMLMS

r_da <- r_data %>%
  filter(#remaining_stock_item_batch > 0,
         !is.na(threshold),
         !is.na(name)
        # state == "Good"
         ) %>% 
  #select(remaining_stock_item_batch,name,unit,product_type) %>% 
  group_by(name, unit.y, category, threshold) %>% 
  summarise(instock = round_half_up(sum(remaining_stock_item_batch))) %>% 
  select(Category = category, 'Item name' = name, 'Qnt instock' = instock, Threshold = threshold, 'In unit' = unit.y) %>%
  arrange(Category, 'Item name')
## `summarise()` has grouped output by 'name', 'unit.y', 'category'. You can override using the `.groups` argument.
# short order to the last row
  r_da <- rbind(r_da %>% filter(Category != "Other"),r_da %>% filter(Category == "Other"))
  
# add to table and formate
  r_da %>% 
  kable(align = c('l','l','c','c',"l"), format.args = list(big.mark = ",")) %>%
  kable_styling(bootstrap_options = c("bordered","condensed", "striped", "hover","responsive")) %>%
  row_spec(0, background = "#E09B43", color = "white", align = "c") %>% 
  row_spec(which(r_da$`Qnt instock` <= r_da$Threshold, r_da$Threshold > 0) , bold = T, background = "#FFE4E1", color = "black") %>% 
# row_spec(which(r_da$`Item name` == "Distilled Water") , background = "white",color = "black") %>% 
  #row_spec(which(r_da$`Qnt instock` <= r_da$Threshold), bold = T, background = "#DC7DED", color = "white") %>% 
  kableExtra::collapse_rows(columns = 1,valign = "top") %>% 
  scroll_box(width = "100%", height = "800px")
Category Item name Qnt instock Threshold In unit
Antibiotic Azithromycin 15mg 200 50 disk
Cefixime 5mg 200 50 disk
Ceftriaxone 30mg 0 50 disk
Ciprofloxacin 5mg 50 50 disk
Cotrimoxazole 25mg 200 50 disk
Gentamicin 10mg 200 50 disk
Tetracycline 30mg 0 50 disk
Consumables 3M attest biological indicator 100 1 box
50ml conic centrifuge tube 775 200 pack
Acetic Acid glacial 2,500 1,200 ml
Airway needle 81,578 1,000 box
Alcohol gel 1 5 unit
Alcohol pad 900 5 box
Aluminum Cap BHI bottle 20mm 35,000 10,000 pack
Aluminum foil 29 5 box
Autoclave bag 30x60cm 1,000 500 unit
Autoclave bags 14L 1,500 500 unit
Betadine 11 4 unit
BHI glass bottle 100ml 10,790 8,415 box
BHI glass bottle 50ml 10,752 7,392 box
Blood bage 250ml 156 100 unit
Borosilicate tube 13x100mm 35,000 16,000 box
Buffer solution pH 10.00 500 250 ml
Buffer solution pH 4.01 500 250 ml
Buffer solution pH 7.00 500 250 ml
CHAM-MATE 30 10 box
Clear scotch tape 21 5 pack
Conductivity Standard 84uS solution 500 500 ml
Cotton Swab Sterile 980 400 unit
Croyobox 100 wells 10 5 unit
Crystal Violet 225 25 gram
Gloves M powder NA 10 box
Gloves S powder NA 10 box
Gram Stain 5x500ml 1 1 kit
Hand towel 24 24 pack
Hydrochloric Acid (HCl) 1,000 500 ml
Junk Label A3 48 20 pack
KimCap 13mm NA 16,000 box
Kovacs indole Reagent 0 20 ml
Liquid hand soap 15 10 unit
Loop 10ul 7,625 500 pack
Loop 1ul 6,250 500 pack
Microscope slides 17 2 box
Na - heparinized capillary tube 400 200 box
Needle 21G 600 5 box
Neutral Red 75 25 gram
Petri dish 53,900 60,000 box
Pipette plastic 3ml sterile 500 500 pack
Pipette Tip sterile 1000ul 480 200 pack
Pipette Tip sterile 200ul 480 200 pack
Plastic bag 7x11 60 30 pack
Potassium chloride (KCl) 250 20 ml
Pourite anti-bubble additive 240 120 ml
Rubber stopper BHI 20mm 15,000 12,000 pack
Screw cap plastic tube 12ml 1,500 500 pack
Steril srew tube 2ml 1,750 500 pack
Sterilized gauze 16 5 pack
Surgical mask 200 200 box
Syringe 10cc 900 200 box
Syringe 20cc 30 20 box
Syringe 5cc 500 100 box
Triple packaging 12 0 unit
Dehydrated media Amies Transport Medium 230 150 gram
Blood Agar Base 17,220 10,000 gram
Brain Heart Infusion Broth 25,900 19,000 gram
CLED agar w/bromothymol blue 830 250 gram
GC Agar Base 4,096 500 gram
Haemoglobin powder NA 3,000 gram
Hektoen Enteric Agar 2,322 1,500 gram
Kligler Iron Agar 1,617 800 gram
Lysine Iron Agar 1,042 500 gram
MacConkey Agar 17,500 10,000 gram
Mannitol Salt Agar 15,480 6,000 gram
Mueller Hinton Agar 500 200 gram
Mueller Hinton Agar II 13,800 12,000 gram
Sabouraud 4% Glucose Agar 500 500 gram
SIM Medium 775 250 gram
Simmons Citrate Agar 570 250 gram
Sodium Chloride (NaCl) 1,000 9 gram
Sodium hydroxide (NaOH) 0 100 gram
Soyabean Casein Digest Agar (TSA) 2,084 960 gram
Soyabean Casein Digest Medium (TSB ) 5,000 200 gram
TCBS 2,614 1,500 gram
Tryptic Soy Blood Agar Base No 2 28,319 13,000 gram
Tryptic Soy Broth 1,928 200 gram
Trypticase Soy Agar 0 960 gram
Urea Agar Base 1,701 250 gram
Supplement Crystal Violet 0.1% 300 50 ml
Glycerol 2,640 1,000 ml
Neutral Red 1% 150 100 ml
Sheep Blood 3,505 0 ml
Sodium Polyanethole Sulfate (SPS) 258 200 gram
Urea supplement 40% 450 400 ml
VCNT supplement 38 50 ml
Vitamino supplement 2,760 3,000 ml
Other Distilled water 4,668,074 0 ml


Dehydrate media powder is critical for the production of culture media. Based on media production data, we express dehydrate media in grams to determine the amount of consumption.

p_data <- data %>% 
  filter(preparation_date >= "2021-01-01") %>% 
  distinct(batch_number,.keep_all = T) %>% # remove duplicated..................
  group_by(powder_name) %>% 
  summarise(total = round_half_up(sum(powder_kg,na.rm = T)*1000)) 

p_data %>% 
  ggplot(aes(reorder(powder_name,-total),total,fill = powder_name)) +
  geom_bar(stat = "identity") + 
  geom_text(aes(label = format(total, big.mark = ",")), hjust = -0.1, size = 3) +
  coord_flip() +
  theme_classic() +
  theme(legend.position = "non", 
        panel.grid.major = element_blank(),
        axis.text = element_text(colour = "black"), 
        plot.title = element_text(color = "blue",face = "bold",hjust = 0.5),
        axis.title = element_text(color = "BlueViolet")) +
  scale_y_continuous(expand = c(0.01,0.01), 
                     limits = c(0,max(p_data$total) + 1000), 
                     label = scales::comma) +
  labs(y = "Quantity in gram", 
       x = "Dehydrate media", 
       title = "Dehydrate media consumption\n from media production data")

3. Sheep Care

Sheep blood is vital supplement to support bacteria growth and visualize hemolysis pattern. To sustain sheep blood supply for CMML, DMDP establish agreement with Resource Development International Cambodia (RDIC) and EUROVET veterinary clinics for care, feeding, bleeding and housing of the sheep.

Fig 1. Sheep pen Fig 2. Sheep farm

sheep_rdi <- import(here("data","Sheep_inventory.xlsx"),range = "A6:B26") %>% 
  clean_names() %>% 
  remove_empty("rows") %>% 
  mutate(farm = "RDIC",
         microchip_no = as.character(microchip_no)) 

sheep_epr <- import(here("data","Sheep_inventory.xlsx"),range = "A31:B54") %>% 
  clean_names() %>% 
  remove_empty("rows") %>% 
  mutate(farm = "EUROVET")

sheep <- bind_rows(sheep_rdi,sheep_epr)

sheep %>% 
  filter(microchip_no != "lamb") %>% 
  group_by(farm,sex) %>% count() %>% 
  ggplot(aes(farm,n,fill = sex)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = n), position = position_stack(vjust = 0.5), size = 3) +
  labs(x = "Farm", y = "Number in head", title = "Sheep Inventory") +
  theme_classic() +
  theme(panel.grid.major = element_blank(),
        axis.text = element_text(colour = "black"), 
        plot.title = element_text(color = "blue",face = "bold",hjust = 0.5),
        plot.subtitle = element_text(color = "blue",hjust = 0.5),
        axis.title = element_text(color = "BlueViolet"))

There are 8 lambs feeding and taking care at EURVET farm. It is not include in the bar chart above.

4. Media Internal Quality Control

CMML performs quality control for all batches of production media before delivery to customers. Table below summaries result of quality control of media. Note: experiment media were excluded from this table.

# import file from excel IQC.xlsx and then filter out column comment having experiment word
iqc <- import(here("data","IQC.xlsx")) %>%
  mutate(exp = str_extract(comments,"Experiment|experiment|exper|Exper"))

iqc <- iqc %>% 
  filter(is.na(exp)) %>% 
  group_by(name_media,qc_result) %>% count() %>%
  pivot_wider(names_from = qc_result,values_from = n) %>% 
  arrange(name_media) %>%  
  adorn_totals(c("row","col")) %>% 
  mutate_all(~replace(., is.na(.), 0)) %>% 
  mutate(name_media = recode(name_media, 
                               "Cystine Lactose Electrolyte Deficient Agar" = "Cystine Lactose                                Electrolyte Deficient Agar (CLED)",
                               "Thiosulfate Citrate Bile Salts Sucrose Agar" = "Thiosulfate                                   Citrate Bile Salts Sucrose Agar (TCBS)"))

# filter column total to calculate percentage
iqc_total <- iqc %>% 
    filter(name_media == "Total") %>% 
    mutate(yes = paste(yes,"(", round(yes/Total * 100,  1) ,"%)"),
           no = paste(no,"(", round(no/Total * 100,  1) ,"%)")) 

# combine file
iqc <- iqc %>% 
filter(name_media != "Total") %>% 
  rbind(.,iqc_total) %>% 
  rename("Media name" = name_media,"Pass" = yes, "Fail" = no)

# show in table
iqc %>% 
  kable(align = c('l','c','c','c')) %>% 
  kable_styling(full_width = T, bootstrap_options = c("bordered","condensed", "striped", "hover","responsive")) %>% 
  row_spec(0,background = "#82E0AA") %>% 
  row_spec(which(iqc$Fail > 0) , bold = T, background = "#FFE4E1", color = "black")
Media name Pass Fail Total
Ashdown’s Agar 8 0 8
Blood Agar 42 1 43
Blood Culture Bottle (adult) 26 0 26
Blood Culture Bottle (child) 6 0 6
Chocolate Agar 28 0 28
Cystine Lactose Electrolyte Deficient Agar (CLED) 8 0 8
GC agar +1% growth supplement 1 0 1
Hektoen Enteric Agar 14 0 14
Kligler Iron Agar 6 0 6
Lysine Iron Agar 7 0 7
MacConkey Agar 23 0 23
Mannitol Salt Agar 13 0 13
Modified Thayer-Martin Agar 2 0 2
Mueller Hinton II Agar 23 0 23
Sheep Blood Mueller-Hinton Agar 7 0 7
Simmons Citrate Agar 4 0 4
Sulfide Indole Motility Medium 4 0 4
Thiosulfate Citrate Bile Salts Sucrose Agar (TCBS) 7 0 7
Trypticase Soy Agar 3 0 3
Trypticase Soy Broth 2 0 2
Trypticase Soy Broth + 20% glycerol 2 0 2
Urea Agar 7 0 7
Total 243 ( 99.6 %) 1 ( 0.4 %) 244

5. Media production

We compute media production data from 1 Jan - 23 Jul 2021

p_data <- data %>% 
  filter(preparation_date >= "2021-01-01") %>% 
  distinct(batch_number,.keep_all = T) %>% # remove duplicated..................
  group_by(media_name) %>% 
  summarise(n = sum(p_quantity)) %>% arrange(-n)

ymax <- p_data %>% 
  top_n(n = 1)
## Selecting by n
p_data %>% 
  ggplot(aes(reorder(media_name, -n),n,fill = media_name)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = format(n, big.mark = ",")),size = 3, hjust = -0.01) +
  coord_flip() +
  theme_classic() +
  theme(legend.position = "non", 
        panel.grid.major = element_blank(),
        axis.text = element_text(colour = "black"), 
        plot.title = element_text(color = "blue",face = "bold",hjust = 0.5),
        plot.subtitle = element_text(color = "blue",hjust = 0.5),
        axis.title = element_text(color = "BlueViolet")) +
  scale_y_continuous(expand = c(0.01,0.01), limits = c(0, ymax$n + 1000)) +
  labs(y = "Quantity", 
       x = "Media name", 
       title = "Cummulative Media Production",
       subtitle = paste0("(n = ",format(sum(p_data$n), big.mark = ",")," unit)")) 

p_data <- data %>% 
  filter(preparation_date >= "2021-01-01") %>% 
  distinct(batch_number, .keep_all = T) %>% 
  group_by(media_name, p_month) %>% 
  mutate(n = sum(p_quantity)) %>% 
  select(media_name,n,p_month) %>% 
  distinct(media_name,n,p_month,.keep_all = T)

p_data %>% 
  ggplot(aes(p_month, n, fill = media_name)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = format(n,big.mark = ",")), size = 2.5, vjust = -0.2) +
  facet_wrap(~ media_name, ncol = 4) +
  theme_bw() +
  theme(strip.text = element_text(face = "bold"), 
        legend.position = "non",
        plot.title = element_text(color = "blue",face = "bold", hjust = 0.5),
        plot.subtitle = element_text(color = "blue", hjust = 0.5),
        axis.title = element_text(color = "BlueViolet")) +
  scale_y_continuous(limits = c(0,max(p_data$n) + 200)) +
  labs(x = "Month", 
       y = "Unit", 
       title = "Media Production by Month",
       subtitle = paste0("(n = ",format(sum(p_data$n), big.mark = ",")," unit)"))

p_data <- data %>% 
  filter(preparation_date >= "2021-01-01") %>% 
  distinct(batch_number,media_name,media_type, .keep_all = T) %>%
  group_by(p_month, media_type) %>% 
  summarise(n = sum(p_quantity),.groups = "drop") %>%
  group_by(p_month) %>% 
  mutate(total = sum(n))

p_data %>% # plot data...........
  ggplot(aes(p_month, n, fill = media_type)) +
  geom_bar(stat = "identity" ) +
  facet_wrap(~ reorder(media_type, -n),ncol = 2) +
  geom_text(aes(label = format(n, big.mark = ",")), size = 3, vjust = -0.2) +
  theme_bw() +
  theme(strip.text = element_text(face = "bold"), 
        legend.position = "non", 
        axis.text = element_text(colour = "black"),
        plot.title = element_text(hjust = 0.5,face = "bold",colour = "blue"),
        plot.subtitle = element_text(hjust = 0.5, color = "blue"), 
        axis.title = element_text(color = "BlueViolet")) +
  scale_y_continuous(expand = c(0.01,0.01),limits = c(0,max(p_data$n) + 3000), labels = scales::comma) +
  labs(x = "Month",
       y = "Quantity", 
       title = "Media Production by Month by Type", 
       subtitle = paste0("(n = ", format(sum(p_data$n), big.mark = ",")," unit)"))

In order to calculate average of media production accurately, we exclude production data of the last month with less than 28 days.

p_data <- data %>% 
    filter(preparation_date >= "2021-01-01") %>% 
    filter(preparation_date <= ifelse(format(max(preparation_date),"%d") >= 28, max(preparation_date), as.Date(max(preparation_date)) - as.numeric(format(max(preparation_date),"%d")))) %>% # max date - max day
    distinct(batch_number,media_name,media_type, .keep_all = T) %>% 
    group_by(p_month, media_type) %>% 
    summarise(n = sum(p_quantity),.groups = "drop")
    
p_data %>% 
  group_by(media_type) %>% 
   summarise("Average (unit)" = round_half_up(mean(n)),
            "Standard Deviation" = round_half_up(sd(n))) %>% 
  rename("Media Type" = media_type) %>% 
  mutate_if(is.numeric, format, big.mark = ",") %>% 
  kable(align = c('l','c','c')) %>% 
  kable_styling(full_width = F, bootstrap_options = c("bordered","condensed", "striped", "hover","responsive")) %>% 
  column_spec(1, width = "25em") %>% 
  row_spec(0, bold = T, background = "#FFC300")
Media Type Average (unit) Standard Deviation
Adult Bottle 944 415
Child Bottle 448 6
Plate 6,793 1,926
Tube 1,630 1,060

6. Media distribution

Media distribution is calculated from 1 Jan - 02 Aug 2021

The bubble in the map show the different sites of customers orders and the size of the bubble indicates the quantity in units. In cooperation with interactive map, you can zoom in and click on map to see data plotting.

# read boundary map
map <- read_sf(here("khm_adm1_un","khm_adm1_un.shp"))
map <- sf::st_make_valid(map)

# data
m_data <- data %>% 
          filter(!is.na(customer_name)) %>% 
          mutate(customer_name = recode(customer_name,
                      "BTB_AFRIMS" = "Battambang",
                      "National Public Health Laboratory - AMR" = "NPHL",
                      "NHealth Laboratory" = "Royal Phnom Penh hospital"
                              )) %>%
  group_by(customer_name) %>%
  summarise(Total = sum(d_quantity,na.rm = T)) 

# import coordination of customer
adr <- import(here("dictionary","customer_name.xlsx"))

# join data and coordination
m_data <- left_join(m_data,adr) %>% 
          st_as_sf(coords = c("x","y"), crs = 4326)
## Joining, by = "customer_name"
tmap_mode("view")
## tmap mode set to interactive viewing
tm_basemap("Esri.WorldTopoMap") +
tm_shape(map) +
  tm_polygons(col = "#AED6F1", alpha = 0.5) + 
  tm_shape(m_data) + 
  tm_bubbles("Total",col = "Total",legend.col.show = F) +
  tm_view(set.view = c(104.8879197, 12.6687923, 7.3)) 
## Legend for symbol sizes not available in view mode.
d_data <- data %>% 
  filter(delivery_date >= "2021-01-01") %>% 
  group_by(media_name) %>% 
  summarise(n = sum(d_quantity),.groups = "drop") %>% 
  arrange(-n) 

d_data %>% 
  ggplot(aes(reorder(media_name, -n), n, fill = media_name)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = format(n, big.mark = ",")), size = 3, hjust = -0.01) +
  coord_flip() +
  theme_classic() +
  theme(legend.position = "non", 
        panel.grid.major = element_blank(), 
        axis.text = element_text(colour = "black"), 
        plot.title = element_text(color = "blue",face = "bold",hjust = 0.5),
        plot.subtitle = element_text(color = "blue",hjust = 0.5), 
        axis.title = element_text(color = "BlueViolet")) +
  scale_y_continuous(expand = c(0.01,0.01),limits = c(0,max(d_data$n) + 1000)) +
  labs(y = "Quanity", 
       x = "Media name", 
       title = "Cummulative Media Distribution", 
       subtitle = paste0("(n = ",format(sum(d_data$n,na.rm = T), big.mark = ",")," unit)")) 

d_data <- data %>% 
  filter(delivery_date >= "2021-01-01") %>% 
  group_by(d_month, media_type) %>% 
  summarise(n = sum(d_quantity),.groups = "drop") %>%
  group_by(d_month) %>% 
  mutate(total = sum(n))

d_data %>% # plot data...........
  ggplot(aes(d_month, n, fill = media_type)) +
  geom_bar(stat = "identity", position = "dodge") +
 #facet_wrap(~ reorder(media_type,-n),ncol = 2)+
  geom_text(aes(label = format(n, big.mark = ",")),
            size = 2.5,vjust = -0.2,hjust = 0.5, 
            position = position_dodge(width = 1)) +
 scale_y_continuous(expand = c(0.01,0.01),limits = c(0,max(d_data$n) + 1250),labels = scales::comma) +
  labs(x = "Month",
       y = "Quantity",
       title = "Media Distribution by Month by Type",
       subtitle = paste0("(n =  ",format(sum(d_data$n,na.rm = T),big.mark = ",")," unit)")) +
    theme_classic() +
     theme(strip.text = element_text(face = "bold"),
        axis.text = element_text(colour = "black"),
        plot.title = element_text(color = "blue",face = "bold", hjust = 0.5),
        plot.subtitle = element_text(color = "blue",hjust = 0.5),
        axis.title = element_text(color = "BlueViolet"),
        legend.title = element_blank(),
        legend.position = c(0.7,0.9),
        legend.direction = "horizontal") 

d_data <- data %>% 
  filter(delivery_date >= "2021-01-01") %>% 
  select(customer_name, d_month, d_quantity, media_type) %>% 
  group_by(customer_name, d_month) %>% 
  summarise(n = sum(d_quantity), .groups = "drop") %>% 
  arrange(d_month) %>% 
  pivot_wider(names_from = d_month,values_from = n) %>% 
  mutate_all(~replace(., is.na(.), 0)) %>% 
  mutate(Total = rowSums(across(where(is.numeric)))) %>% 
  arrange(-Total) %>% 
  rename('Customer Name' = customer_name)

d_data %>% 
   mutate_if(is.numeric, format, big.mark = ",") %>% 
   kable(align = c('l','c','c','c','c','c','c','c','c','c','c','c','c')) %>% 
   kable_styling(fixed_thead = T, full_width = T, bootstrap_options = c("bordered","condensed", "striped", "hover","responsive")) %>% 
  row_spec(0,background = "#CCCCFF") %>% 
  footnote(general_title = "","NPHL: National Public Health Laboratory,
               BOM: Blue Opportunity Medical Co.,Ltd.,
               NHealth Laboratory: Royal Phnom Penh hospital's laboratory")
Customer Name Jan Feb Mar Apr May Jun Jul Aug Total
Siem Reap 3,060 2,130 1,770 960 3,519 1,370 770 0 13,579
Takeo 1,550 1,790 2,010 1,600 1,070 1,050 880 0 9,950
Battambang 0 1,390 0 1,710 2,900 0 0 0 6,000
Kampong Cham 580 1,060 1,170 840 860 767 680 0 5,957
Khmer Soviet Friendship Hospital 1,130 1,160 2,230 0 200 0 160 0 4,880
NPHL 1,040 980 0 0 590 220 580 970 4,380
Sunrise Hospital 550 10 880 0 500 910 0 0 2,850
Dynamic Pharma 830 750 0 0 0 1,110 0 0 2,690
NHealth Laboratory 0 1,190 0 630 0 560 190 0 2,570
Kossamak 800 650 820 0 0 0 250 0 2,520
BOM 240 230 290 310 190 310 510 0 2,080
US NAMRU-2 0 640 310 350 0 70 540 0 1,910
BTB_AFRIMS 0 200 560 0 0 0 700 0 1,460
Biobykin 580 220 0 80 100 70 220 0 1,270
National Pediatric Hospital 0 0 0 300 300 0 300 0 900
Sihanouk Hospital Center of Hope 400 400 0 0 0 0 0 0 800
Pro Labpratory 80 90 210 0 150 90 0 0 620
Central Media Making Laboratory 10 136 20 67 122 100 103 0 558
Diagnostic and Detection Laboratory 0 160 140 0 0 80 0 0 380
Olympia Medical Hub 0 0 360 0 0 0 0 0 360
Svay Rieng 0 0 340 0 0 0 0 0 340
Central Laboratory 60 60 0 80 0 0 90 0 290
Amatak Laboratory 150 0 50 60 0 0 0 0 260
Sonja kill 0 40 0 0 0 220 0 0 260
International Standard lab 40 0 80 0 0 0 70 0 190
Urology clinic 30 50 40 0 0 0 60 0 180
Saravorn Laboratory 0 0 0 0 0 10 0 0 10
NPHL: National Public Health Laboratory,
BOM: Blue Opportunity Medical Co.,Ltd.,
NHealth Laboratory: Royal Phnom Penh hospital’s laboratory 
data %>% 
  filter(delivery_date >= "2021-01-01") %>%
  select(customer_type, d_month, d_quantity, media_type) %>% 
  group_by(customer_type, media_type) %>% 
  summarise(n = sum(d_quantity),.groups = "drop") %>% 
  ggplot(aes(reorder(customer_type,-n),n,fill = media_type)) +
  geom_col(position = position_stack(reverse = T)) +
  geom_text(aes(label = ifelse(n < 300,"",format(n, big.mark = ","))), size = 2.5,position =  position_stack(reverse = T, vjust = 0.5)) +
  coord_flip() +
  theme_classic() +
  theme(legend.position = "bottom",legend.title = element_blank(),axis.text = element_text(colour = "black"),plot.title = element_text(hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5),axis.title = element_text(color = "BlueViolet")) + scale_y_continuous(expand = c(0.01,0), labels = scales::comma, limits = c(0,NA)) + guides(fill = guide_legend((override.aes = c("red","purple","yellow","green")))) +
  labs(x = "",y = "Quantity",title = "TYPE OF MEDIA DISTRIBUTE to CUSTOMER")

From the start of the year, CMML distributed quality controlled media to different groups of customers around the country. Customers are classified in four groups:
1. Government laboratory supported by DMDP: Siem Reap, Battambang, Kampong Cham, Takeo and National Public Health Laboratory
2. Government laboratory supported by project: e.g AMR surveillance, stool project in Battambang
3. Government laboratory purchased: interestingly with an increase in orders from government laboratories e.g Khmer Soviet Friendship Hospital, Cambodia China Friendship Hospital (Kossamak), National Pediatric Hospital,…
4. Private laboratory purchased: e.g Royal Phnom Penh hospital department of laboratory, International Laboratory, Dynamic pharma….

d_data <- data %>% 
  filter(delivery_date >= "2021-01-01") %>% 
  select(media_type,media_name, customer_name, customer_type, d_quantity,cost) %>% 
  group_by(customer_type,media_type) %>% 
  summarise(n = sum(d_quantity,na.rm = T),.groups = "keep") %>%
  ungroup()

d_data %>% 
  ggplot(aes(factor(customer_type,levels = c("Govt. Lab supported by DMDP","Govt. Lab supported by project","Govt. Lab (purchased)","Private Lab (purchased)","Training/promotion")), n,fill = media_type)) + 
  geom_bar(stat = "identity") +
  geom_text(aes(label = format(n, big.mark = ",")), hjust = -0.1, size = 3) + 
  facet_wrap(~media_type) + 
  coord_flip() + 
  labs(x = "",
       y = "Quantity",
       title = "Media Distubution by Cusotmer Type and Media Type",
       subtitle = paste0("(n =  ",format(sum(d_data$n),big.mark = ",")," unit)")) +
  scale_y_continuous(labels = scales::comma, expand = c(0,0),limits = c(0,max(d_data$n) + 5000)) +
  theme_bw() +
  theme(legend.position = "non",
        strip.text = element_text(face = "bold"),
        axis.text = element_text(colour = "black"),
        plot.title = element_text(color = "blue",face = "bold",hjust = 0.5),
         plot.subtitle = element_text(color = "blue",hjust = 0.5))

d_data <- data %>% 
  filter(delivery_date >= "2021-01-01") %>% 
  select(media_name, customer_name, customer_type, d_quantity,cost) %>% 
  group_by(customer_type) %>%
  summarise(n = sum(cost,na.rm = T),.groups = "keep") %>%
  ungroup() %>% 
  mutate(percentage = round_half_up(n/sum(n)*100))

d_data %>% 
  ggplot(aes(x = "",
             y = n, 
             fill = factor(customer_type,
                           levels = c("Govt. Lab supported by DMDP",
                                      "Govt. Lab supported by project",
                                      "Govt. Lab (purchased)",
                                      "Private Lab (purchased)",
                                      "Training/promotion")))) +
  geom_bar(stat = "identity") +
  coord_polar("y",start = 3.5, direction = -1) +
  theme_void() +
  geom_text_repel(aes(x = 1.1,label = paste0(format(round_half_up(n), big.mark = ",")," $"," (",percentage,"%)")),
                  position = position_stack(vjust = 0.5)) +
  theme(plot.title = element_text(hjust = 0.5), 
        plot.subtitle = element_text(hjust = 0.5)) + 
  labs(title = "Income from Media Distribution", 
       subtitle = paste0("Cost = (", format( round_half_up(sum(d_data$n,na.rm = T)), big.mark = ",")," USD)"),
       fill = "Customer type")

We summarised quantity and cost in USD for the DMDP supported laboratory by month for routine diagnostic.

d_data <- data %>% 
  select(customer_name, delivery_date, d_month, media_type, d_quantity, cost) %>% 
  filter(customer_name %in% c("Siem Reap", "Battambang", "Takeo", "Kampong Cham", "NPHL"),
         delivery_date >= "2021-01-01") %>% 
  group_by(d_month,customer_name,media_type) %>% 
  summarise(total = sum(d_quantity,na.rm = T),
            cost = sum(cost,na.rm = T)) %>% 
  arrange(d_month) %>% 
  mutate(Qnt_cost = paste(total,"(",round_half_up(cost),"$)")) %>% 
  select(-total,-cost) %>% 
  pivot_wider(names_from = d_month, values_from = Qnt_cost) %>% 
  arrange(customer_name, media_type) %>%
  rename("Cusomter Name" = customer_name, 
         "Media Type" = media_type) %>% 
  mutate_all(~replace(., is.na(.), 0))
## `summarise()` has grouped output by 'd_month', 'customer_name'. You can override using the `.groups` argument.
## `mutate_all()` ignored the following grouping variables:
## Column `Cusomter Name`
## Use `mutate_at(df, vars(-group_cols()), myoperation)` to silence the message.
d_data %>% 
   mutate_if(is.numeric, format, big.mark = ",") %>% 
   kable(align = c('l','c','c','c','c','c','c','c','c','c','c','c','c')) %>% 
   collapse_rows(1, valign = "middle") %>% 
   kable_styling(fixed_thead = T, full_width = T, bootstrap_options = c("bordered","condensed", "striped", "hover","responsive")) %>% 
  row_spec(0, background = "#C6E2FF") %>% 
  footnote(general_title = "","No price list for media: Trypticase Soy Broth,   
Trypticase Soy Broth + 20% glycerol, Modified Thayer-Martin Agar, GC agar +1% growth supplement") 
## `mutate_if()` ignored the following grouping variables:
## Column `Cusomter Name`
Cusomter Name Media Type Jan Feb Mar Apr May Jun Jul Aug
Battambang Adult Bottle 0 300 ( 516 $) 0 0 300 ( 516 $) 0 0 0
Child Bottle 0 50 ( 81 $) 0 0 150 ( 243 $) 0 0 0
Plate 0 640 ( 564 $) 0 650 ( 653 $) 1270 ( 1327 $) 0 0 0
Tube 0 400 ( 342 $) 0 1060 ( 810 $) 1180 ( 925 $) 0 0 0
Kampong Cham Adult Bottle 0 50 ( 86 $) 150 ( 258 $) 60 ( 103 $) 150 ( 258 $) 0 0 0
Child Bottle 0 50 ( 81 $) 50 ( 81 $) 0 0 100 ( 162 $) 100 ( 162 $) 0
Plate 390 ( 415 $) 710 ( 748 $) 920 ( 976 $) 780 ( 823 $) 550 ( 578 $) 500 ( 509 $) 530 ( 543 $) 0
Tube 190 ( 160 $) 250 ( 213 $) 50 ( 0 $) 0 160 ( 136 $) 167 ( 121 $) 50 ( 40 $) 0
NPHL Adult Bottle 10 ( 17 $) 0 0 0 20 ( 34 $) 0 10 ( 17 $) 10 ( 17 $)
Child Bottle 10 ( 16 $) 0 0 0 10 ( 16 $) 0 0 0
Plate 920 ( 864 $) 880 ( 820 $) 0 0 560 ( 551 $) 220 ( 209 $) 470 ( 336 $) 680 ( 664 $)
Tube 100 ( 0 $) 100 ( 0 $) 0 0 0 0 100 ( 85 $) 280 ( 214 $)
Siem Reap Adult Bottle 500 ( 860 $) 400 ( 688 $) 400 ( 688 $) 0 600 ( 1032 $) 50 ( 86 $) 50 ( 86 $) 0
Child Bottle 100 ( 162 $) 0 20 ( 32 $) 0 200 ( 324 $) 0 20 ( 32 $) 0
Plate 1910 ( 1969 $) 1230 ( 1350 $) 1200 ( 1253 $) 620 ( 496 $) 2090 ( 2188 $) 1040 ( 1145 $) 400 ( 368 $) 0
Tube 550 ( 427 $) 500 ( 427 $) 150 ( 128 $) 340 ( 293 $) 629 ( 506 $) 280 ( 236 $) 300 ( 256 $) 0
Takeo Adult Bottle 210 ( 361 $) 230 ( 396 $) 250 ( 430 $) 230 ( 396 $) 200 ( 344 $) 160 ( 275 $) 100 ( 172 $) 0
Child Bottle 100 ( 162 $) 100 ( 162 $) 100 ( 162 $) 100 ( 162 $) 100 ( 162 $) 50 ( 81 $) 50 ( 81 $) 0
Plate 880 ( 904 $) 1220 ( 1280 $) 1260 ( 1326 $) 920 ( 962 $) 620 ( 633 $) 690 ( 721 $) 680 ( 707 $) 0
Tube 360 ( 190 $) 240 ( 206 $) 400 ( 289 $) 350 ( 247 $) 150 ( 73 $) 150 ( 43 $) 50 ( 33 $) 0
No price list for media: Trypticase Soy Broth,
Trypticase Soy Broth + 20% glycerol, Modified Thayer-Martin Agar, GC agar +1% growth supplement 
rm(list = ls())

Reported by CMML


06-Aug-2021